home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue48 / System / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-06-24  |  3.5 KB  |  134 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.     StdCtrls, ComCtrls, ExtCtrls;
  8.  
  9. type
  10.     TMainForm = class(TForm)
  11.     Scan: TButton;
  12.     StatusBar1: TStatusBar;
  13.     TreeList: TListView;
  14.     procedure ScanClick(Sender: TObject);
  15.     procedure TreeListDblClick(Sender: TObject);
  16.     private
  17.     { Private declarations }
  18.         Scanning: Boolean;
  19.         procedure ScanDrive (const Path: String);
  20.         procedure FoundOne (const PathName: String);
  21.     public
  22.       { Public declarations }
  23.     end;
  24.  
  25. var
  26.   MainForm: TMainForm;
  27.  
  28. implementation
  29.  
  30. uses DCUDefs, Report;
  31.  
  32. {$R *.DFM}
  33.  
  34. procedure TMainForm.ScanClick (Sender: TObject);
  35. var
  36.     p: PChar;
  37.     szBuff: array [0..255] of Char;
  38. begin
  39.     Scanning := not Scanning;
  40.     if Scanning then begin
  41.         Scan.Caption := 'Stop Scan!';
  42.         Screen.Cursor := crHourGlass;
  43.         TreeList.Items.Clear;
  44.         TreeList.Items.BeginUpdate;
  45.  
  46.         try
  47.             p := szBuff;
  48.             GetLogicalDriveStrings (sizeof (szBuff), szBuff);
  49.             while Scanning and (p^ <> #0) do begin
  50.                 if GetDriveType (p) = Drive_Fixed then ScanDrive (p);
  51.                 Inc (p, 4);
  52.             end;
  53.         finally
  54.             Scanning := False;
  55.             Scan.Caption := 'Scan!';
  56.             Screen.Cursor := crDefault;
  57.             TreeList.Items.EndUpdate;
  58.         end;
  59.     end;
  60. end;
  61.  
  62. procedure TMainForm.FoundOne (const PathName: String);
  63. var
  64.     eof: Byte;
  65.     S: String;
  66.     Valid: Boolean;
  67.     fs: TFileStream;
  68.     Item: TListItem;
  69.     Magic: array [0..3] of LongInt;
  70. begin
  71.     fs := TFileStream.Create (PathName, fmOpenRead);
  72.     try
  73.         fs.Read (Magic, sizeof (Magic));
  74.         fs.Position := fs.Size - 1;
  75.         fs.Read (eof, sizeof (eof));
  76.         Valid := (Magic [1] = fs.Size) and (eof = Tag_End);
  77.     finally
  78.         fs.Free;
  79.     end;
  80.  
  81.     if Valid then begin
  82.         Item := TreeList.Items.Add;
  83.         Item.Caption := PathName;
  84.         case Magic [0] of
  85.             D2Magic:   S := 'Delphi 2';
  86.             D3Magic:   S := 'Delphi 3';
  87.             D4Magic:   S := 'Delphi 4';
  88.             B3Magic:   S := 'C++ Builder 3';
  89.             D5Magic:   S := 'Delphi 5';
  90.             else       S := '???' + IntToHex (Magic [0], 8);
  91.         end;
  92.         Item.SubItems.Add (S);
  93.  
  94.         if Magic [2] = $ffffffff then S := 'Invalid date/time' else
  95.         S := FormatDateTime ('dddd, mmmm d, yyyy, hh:mm AM/PM', FileDateToDateTime (Magic [2]));
  96.         Item.SubItems.Add (S);
  97.     end;
  98. end;
  99.  
  100. procedure TMainForm.ScanDrive (const Path: String);
  101. var
  102.     Res: Integer;
  103.     SR: TSearchRec;
  104. begin
  105.     Application.ProcessMessages;
  106.     StatusBar1.Panels [0].Text := 'Scanning ' + Path;
  107.     Res := FindFirst (Path + '*.*', faAnyFile, SR);
  108.     try
  109.         while Scanning and (Res = 0) do begin
  110.             if SR.Name [1] <> '.' then begin
  111.                 if UpperCase (ExtractFileExt (SR.Name)) = '.DCU' then FoundOne (Path + SR.Name) else
  112.                 if ((SR.Attr and faDirectory) <> 0) then ScanDrive (Path + SR.Name + '\');
  113.             end;
  114.             Res := FindNext (SR);
  115.         end;
  116.     finally
  117.         FindClose (SR);
  118.     end;
  119. end;
  120.  
  121. procedure TMainForm.TreeListDblClick(Sender: TObject);
  122. begin
  123.     if TreeList.Selected <> Nil then with TReportForm.Create (Self) do try
  124.         Caption := TreeList.Selected.Caption;
  125.         ShowModal;
  126.     finally
  127.         Free;
  128.     end;
  129. end;
  130.  
  131. end.
  132.  
  133.  
  134.